home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / newsgrp / group00b.txt / 000012_icon-group-sender _Mon Jul 10 07:46:06 2000.msg < prev    next >
Internet Message Format  |  2001-01-03  |  5KB
  1. Return-Path: <icon-group-sender>
  2. Received: (from root@localhost)
  3.     by baskerville.CS.Arizona.EDU (8.9.1a/8.9.1) id HAA19920
  4.     for icon-group-addresses; Mon, 10 Jul 2000 07:44:44 -0700 (MST)
  5. Message-Id: <200007101444.HAA19920@baskerville.CS.Arizona.EDU>
  6. Date: Fri, 07 Jul 2000 20:50:58 -0700
  7. From: Steve Wampler <sbw@tapestry.tucson.az.us>
  8. X-Accept-Language: en
  9. To: icon-group@optima.CS.Arizona.EDU
  10. Subject: Friday puzzle...
  11. Errors-To: icon-group-errors@optima.CS.Arizona.EDU
  12. Status: RO
  13. Content-Length: 4363
  14.  
  15. This is a multi-part message in MIME format.
  16. --------------F23570175734CDBF613A10C4
  17. Content-Type: text/plain; charset=us-ascii
  18. Content-Transfer-Encoding: 7bit
  19.  
  20.  
  21. Every so often I've posed a programming problem here for Iconites to
  22. work on.  Here's another one, but this time I'm providing an
  23. initial solution and the challenge is to find a faster solution
  24. (the solution attached here is pretty slow...)
  25.  
  26. My son David asked me today a question about genetics: "If blood type O
  27. is a recessive gene, then why does it dominate in the population?"
  28. (~46% of the population is either O positive or O negative).
  29.  
  30. Well, I don't have an answer, so attached is a program to simulate
  31. a population w.r.t a genetic trait (in this case, blood type).  The
  32. program is patterned (uh, loosely) after a real population - there
  33. are humans, couples, births, and deaths, after a fashion.
  34.  
  35. Interestingly enough, starting with a population that is ~25% O
  36. (the program combines positive and negative into the types), the
  37. percentage is around 22% after 116 generations (which is as far as
  38. the program has gotten while I'm typing this).
  39.  
  40. Anyway, can you find a faster way to simulate the population across
  41. generations?
  42.  
  43. I'd also appreciate a correct answer to David's question that both
  44. he and I can understand!
  45.  
  46. ---
  47. Steve Wampler     {sbw@tapestry.tucson.az.us}
  48. The gods that smiled upon your birth are laughing now. -- fortune cookie
  49. --------------F23570175734CDBF613A10C4
  50. Content-Type: text/plain; charset=us-ascii;
  51.  name="blood.icn"
  52. Content-Disposition: inline;
  53.  filename="blood.icn"
  54. Content-Transfer-Encoding: 7bit
  55.  
  56. #
  57. # Simulate the gene pool w.r.t. blood types
  58. #
  59. global btypes            # Genetic trait is blood type
  60. record human(gene1, gene2)      # A human has two blood type genes
  61. record couple(p1, p2)        # Takes two to tango
  62.  
  63. procedure main(args)
  64.  
  65.    # introduce some randomess from one run to the next
  66.    write("Random seed: ",randSeed := &clock)
  67.    &random := map("HhMmSs","Hh:Mm:Ss", randSeed)
  68.  
  69.    btypes := "ON"    # simplify things "O" and "Not O"
  70.    nHumans := 10000    # small population
  71.  
  72.    pool := createGenePool(nHumans)
  73.    analyzePool(pool)
  74.  
  75.    every generation := 1 to 1000 do {        # run for a lot of generations
  76.        pool := alterPool(pool)
  77.        if (generation % 1) == 0 then {       # display every so often
  78.            write("Generation ",generation)
  79.            analyzePool(pool, "\t")
  80.            }
  81.        }
  82.    
  83. end
  84.  
  85. #
  86. # Create the initial population
  87. #
  88. procedure createGenePool(size)
  89.     pool := set()
  90.     every 1 to size do insert(pool, newHuman())
  91.     return pool
  92. end
  93.  
  94. #
  95. # Create a new human, about 1 in 4 will be O blood type
  96. #
  97. procedure newHuman()
  98.     static initOdds
  99.     initial initOdds := repl("O",50) || repl("N",50)
  100.  
  101.     return human(?initOdds, ?initOdds)        # random genes
  102.  
  103. end
  104.  
  105. #
  106. # See how the population is doing
  107. #
  108. procedure analyzePool(pool, prefix)
  109.     /prefix := ""
  110.     nO := nN := 0
  111.     every person := !pool do {
  112.        if (person.gene1 == "O") & (person.gene2 == "O") then
  113.           nO +:= 1
  114.        else
  115.           nN +:= 1
  116.        }
  117.  
  118.     write(prefix, "Pool Size is: ",*pool)
  119.     write(prefix, "\tNumber O type: ",nO)
  120.     write(prefix, "\tNumber not O type: ",nN)
  121.     write(prefix, "\t% O type: ",real(nO)/*pool)
  122.     write()
  123. end
  124.  
  125. #
  126. # Put the population through a generation
  127. #
  128. procedure alterPool(pool)
  129. static childProb        # help in selecting number of children
  130. initial childProb := [0,0,1,1,1,2,2,2,3,3,4]
  131.  
  132.     newPool := set()
  133.     parents := []
  134.     every put(parents, marryOff(pool))    # wow, everyone marries!
  135.  
  136.     # create the next generation
  137.     #
  138.     every pair := !parents do {
  139.        insert(newPool, pair.p1)
  140.        insert(newPool, pair.p2)
  141.        every 1 to ?childProb do {
  142.            # children get a gene from each parent
  143.            person := human(?(pair.p1), ?(pair.p2))
  144.            insert(newPool, person)
  145.            }
  146.        }
  147.  
  148.     # now kill off enough to keep the population growth small
  149.     *
  150.     deaths := integer(*newPool * 0.46)
  151.     every 1 to deaths do {
  152.         delete(newPool, ?newPool)
  153.         }
  154.  
  155.     return newPool
  156. end
  157.  
  158. # Marry pairs of humans off (ok, so apparently the sex of each parent
  159. #   isn't important - must be New Hampshire?)
  160. #
  161. procedure marryOff(pool)
  162.    while *pool > 1 do {
  163.        delete(pool, p1 := ?pool)
  164.        delete(pool, p2 := ?pool)
  165.        suspend couple(p1, p2)
  166.        }
  167. end
  168.  
  169. --------------F23570175734CDBF613A10C4--
  170.  
  171.